Shareware Grab Bag/Shareware Grab Bag.iso/013/diskchk.pas

Pascal/Delphi Source File | 1986-09-11 | 26.0 KB | 826 lines

{*************************************************************************}
{*         Copyright (c) Kim Kokkonen, TurboPower Software, 1986         *}
{*  Released to the public domain for personal, non-commercial use only  *}
{*************************************************************************}
{.F-}
{
This program analyzes any set of files on any MSDOS disk drive to
determine a measure of performance efficiency. The performance measure
is based on how many sets of file sectors are not contiguous. When
the sectors of a file are not contiguous, read and write times are
longer since the drive heads are forced to seek to each non-contiguous
sector.

MSDOS Wildcards can be used to select any desired group of files in
any drive or directory. A "Recursive" option allows you to look at
all subdirectories of the start directory, and thus the entire disk
if desired.

Output includes a list of all files analyzed with various analytical
information. Optionally, only those files with non-contiguous sectors
can be listed. The output is written to STDOUT, so that it can be
redirected or piped.

A final summary section gives statistics for all of the files analyzed.
This section is not redirectable.

Examples:

DISKCHK -?
  writes a help screen and halts.

DISKCHK
  looks at all files in the current directory and writes to screen.

DISKCHK C:\*.COM -R >BREAKS.DAT
  looks at all COM files on drive C: and writes those with breaks
  to the file BREAKS.DAT.

DISKCHK A: | MORE
  pages all files in the root directory of drive A: through the
  DOS MORE filter.

Written 1/21/86. Kim Kokkonen, TurboPower Software.
408-378-3672. Compuserve 72457,2131.

Requires Turbo Pascal version 3 to compile.
No known dependencies on the PCDOS version of Turbo.
Compile with max heap = $A000 to allow maximum recursion
area for subdirectory searching.
}
{.F+}
{$P512}
{$C-}

PROGRAM DiskEfficiency(Output);
  {-measure the fraction of non-contiguous sectors in a group of files}
CONST
  MaxFiles = 1024;            {max number of files searched in a given directory}
  MaxDirs = 128;              {maximum number of dirs in a given directory}
  OptionChar = '-';           {character which prefixes options on command line}
  version : string[4] = '1.00';

TYPE
  DriveName = STRING[2];
  FileString = STRING[12];
  PathName = STRING[64];
  FileName = STRING[8];
  ExtName = STRING[3];
  LongString = STRING[255];
  FnameType = ARRAY[0..7] OF Char;
  FextType = ARRAY[0..2] OF Char;
  FATinRAM = ARRAY[0..32767] OF Byte;

  Darray =
  RECORD
    num : Integer;
    arr : ARRAY[1..MaxDirs] OF FileString;
  END;

  CompositeFilename =
  RECORD
    name : FileName;
    ext : ExtName;
  END;

  Farray =
  RECORD
    num : Integer;
    arr : ARRAY[1..MaxFiles] OF CompositeFilename;
  END;

  DTArec =
  RECORD
    DOSnext : ARRAY[1..21] OF Byte;
    attr : Byte;
    fTime, fDate, flSize, fhSize : Integer;
    FullName : ARRAY[1..13] OF Char;
  END;

  UnopenedFCBrec =
  RECORD
    flag : Byte;
    junk : ARRAY[0..4] OF Byte;
    SearchAttr : Byte;
    drive : Byte;
    fName : FnameType;
    fExt : FextType;
    attr : Byte;
    DOSnext : ARRAY[12..21] OF Byte;
    fTime, fDate, fCluster, flSize, fhSize : Integer;
  END;

  Registers =
  RECORD
    CASE Integer OF
      1 : (ax, bx, cx, dx, bp, si, di, ds, es, flags : Integer);
      2 : (al, ah, bl, bh, cl, ch, dl, dh : Byte);
  END;

VAR
  reg : Registers;
  SavePath, StartPath : PathName;
  ConsoleOut, WroteFile, bigFAT, recursive, verbose : Boolean;
  dta : DTArec;
  tStart, tStop : Real;
  err : Text[128];            {non-redirectable status output written here}
  files : Farray;
  FATbytes, FATsectors, secSize, AvailableClusters, fBroken,
  TotalBreaks, ClustersUsed, fCount, alloUnits, secsPerAllo : Integer;
  FAT : ^FATinRAM;

  PROCEDURE error(errnum, erraddr : Integer);
    {-get back to home in case of a crash}
  BEGIN
    ChDir(SavePath);
    Halt(1);
  END;

  PROCEDURE Time(VAR sec : Real);
    {-return time of day in seconds since midnight}
  BEGIN
    reg.ah := $2C;
    MsDos(reg);
    sec := 1.0*(reg.dh+60.0*(reg.cl+60.0*reg.ch)+reg.dl/100.0);
  END;                        {time}

  PROCEDURE DoHalt(exitcode : Integer);
    {-halt}
  BEGIN
    ChDir(SavePath);
    Halt(exitcode);
  END;                        {dohalt}

  FUNCTION BreakPressed : Boolean;
    {-true if Break key has been pressed}
    {-note that keypressed function executes int 23 if ^C has been pressed}
  VAR
    c : Char;
    breakdown : Boolean;
  BEGIN
    {check current state}
    breakdown := False;
    WHILE KeyPressed AND NOT(breakdown) DO BEGIN
      Read(Kbd, c);
      IF c = ^C THEN breakdown := True;
    END;
    BreakPressed := breakdown;
  END;                        {breakpressed}

  PROCEDURE BreakHalt;
    {-executed when break is detected}
    {-exit with return code 1}
  BEGIN
    ChDir(SavePath);
    Halt(1);
  END;                        {breakhalt}

  PROCEDURE SetBreak;
    {-set the ctrl-break address to a process exit handler}
  BEGIN
    reg.ax := $2523;
    reg.ds := CSeg;
    reg.dx := Ofs(BreakHalt);
    MsDos(reg);
  END;                        {setbreak}

  FUNCTION IOstat(bit : Integer) : Boolean;
    {-check status of the standard I/O}
    {bit=0 for input, 1 for output}
    {returns true if I/O is through console}
  VAR
    temp0, temp1 : Boolean;
  BEGIN
    reg.ax := $4400;
    reg.bx := bit {standard input or output} ;
    MsDos(reg);
    temp0 := reg.dx AND 128 <> 0;
    temp1 := reg.dx AND (1 SHL bit) <> 0;
    iostat := temp0 AND temp1;
  END {iostat} ;

  PROCEDURE ParsePath(VAR start : PathName;
                      VAR dName : DriveName;
                      VAR pName : PathName;
                      VAR fName : FileString);
    {-parse a full (perhaps incomplete) pathname into component parts}
  VAR
    i : Integer;

    FUNCTION FileExists(s : PathName; attr : Integer) : Boolean;
      {-determine whether a file exists with the specified attribute}
    BEGIN
      reg.ah := $4E;
      s[Succ(Length(s))] := #0;
      reg.ds := Seg(s);
      reg.dx := Ofs(s[1]);
      reg.cx := attr;
      MsDos(reg);
      FileExists := ((reg.flags AND 1) = 0) AND ((dta.attr AND 31) = attr);
    END;                      {fileexists}

  BEGIN
    {get drive name}
    i := Pos(':', start);
    IF i = 0 THEN BEGIN
      dName := '';
      pName := start;
    END ELSE BEGIN
      dName := Copy(start, 1, i);
      IF i = Length(start) THEN pName := '\'
      ELSE pName := Copy(start, Succ(i), 64);
    END;

    {see if wildcard specified}
    i := Pos('*', start)+Pos('?', start);

    {separate out filename and pathname}
    IF (i = 0) AND (FileExists(start, 16) OR (pName = '\')) THEN BEGIN
      {start specifies a subdirectory}
      fName := '*.*';
      IF pName <> '\' THEN pName := pName+'\';
    END ELSE BEGIN
      {parse out filename on end}
      i := Length(pName);
      WHILE (i > 0) AND NOT(pName[i] IN [':', '\', '/']) DO i := Pred(i);
      fName := Copy(pName, Succ(i), 63);
      pName := Copy(pName, 1, i);
      IF pName = '' THEN GetDir(0, pName);
      IF pName[Length(pName)] <> '\' THEN pName := pName+'\';
    END;
  END;                        {parsepath}

  FUNCTION Path(dName : DriveName; pName : PathName) : PathName;
    {-return legal pathname for chdir}
  VAR
    t : PathName;
  BEGIN
    t := dName;
    IF pName = '\' THEN
      t := t+pName
    ELSE
      t := t+Copy(pName, 1, Pred(Length(pName)));
    Path := t;
  END;                        {path}

  FUNCTION ReturnDriveNum(dName : DriveName) : Byte;
    {-return the drive number for an FCB call, 1=A, 2=B}
  CONST
    DriveLets : STRING[26] = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  BEGIN
    IF dName = '' THEN
      ReturnDriveNum := 0
    ELSE
      ReturnDriveNum := Pos(UpCase(dName[1]), DriveLets);
  END;                        {returndrivenum}

  FUNCTION StUpcase(s : LongString) : LongString;
    {-return the uppercase of a string}
  VAR
    i : Byte;
  BEGIN
    FOR i := 1 TO Length(s) DO s[i] := UpCase(s[i]);
    StUpcase := s;
  END;                        {stupcase}

  PROCEDURE SetOptions;
    {-read command line and set up options and defaults}
  VAR
    i : Integer;
    c : Char;
    HaltSoon : Boolean;
    param : LongString;

    PROCEDURE WriteHelp;
    BEGIN
      WriteLn(err, 'Usage: DISKCHK [Options] [SearchPath] [>ResultFile]');
      WriteLn(err);
      WriteLn(err, '  DISKCHK measures the storage efficiency of any group of files on');
      WriteLn(err, '  any floppy or hard disk supported by MSDOS. It returns a list of');
      WriteLn(err, '  files with the number of clusters used, the number of non-contiguous');
      WriteLn(err, '  clusters and a measure of the efficiency of storage as it will affect');
      WriteLn(err, '  read/write performance. If all clusters are contiguous, the efficiency');
      WriteLn(err, '  is rated as 100%. Otherwise, the efficiency is downgraded by the');
      WriteLn(err, '  percentage of clusters that are non-contiguous.');
      WriteLn(err);
      WriteLn(err, '  If no options are specified, the files in the current drive and');
      WriteLn(err, '  directory are analyzed, and a report listing all non-contiguous');
      WriteLn(err, '  files found is written to the standard output.');
      WriteLn(err);
      WriteLn(err, 'Options:');
      WriteLn(err, '  SearchPath    Start in the specified drive and directory, and search');
      writeln(err, '                those files matching any filespec given (wildcards ok).');
      writeln(err, '                If not specified, all files in current dir are analyzed.');
      WriteLn(err, '  -R            search Recursively, down all subdirectories found.');
      WriteLn(err, '  -V            Verbose mode. Write all files, including contiguous ones.');
      WriteLn(err, '  -A            Automatic mode. Analyzes entire default drive.');
      WriteLn(err, '  -?            write this Help message.');
      DoHalt(2);
    END;                      {writehelp}

    PROCEDURE DoError(message : LongString);
      {-display an error message}
    BEGIN
      WriteLn(err, message);
      HaltSoon := True;
    END;                      {doerror}

  BEGIN
    {get options}
    WriteLn(err);
    HaltSoon := False;
    i := 1;
    WHILE i <= ParamCount DO BEGIN
      {analyze options}
      param := ParamStr(i);
      IF param[1] = OptionChar THEN BEGIN
        {an option}
        IF Length(param) = 2 THEN BEGIN
          c := UpCase(param[2]);
          CASE c OF
            '?' : WriteHelp;
            'R' : recursive := True;
            'V' : verbose := true;
            'A' : BEGIN
                    recursive := True;
                    StartPath := '\';
                  END;
          END;
        END ELSE
          DoError('Unrecognized command option....'+ParamStr(i));
      END else
        {search path}
        StartPath := StUpcase(ParamStr(i));
      i := Succ(i);
    END;
    IF HaltSoon THEN BEGIN
      WriteLn(err, 'Type DISKCHK -? for help....');
      DoHalt(2);
    END;
  END;                        {setoptions}

  PROCEDURE SetDTA(VAR dta : DTArec);
    {-set new DTA address}
  BEGIN
    reg.ah := $1A;
    reg.ds := Seg(dta);
    reg.dx := Ofs(dta);
    MsDos(reg);
  END;                        {setdta}

  PROCEDURE ScanFiles(StartPath : PathName);
    {-get all files in pathnamed directory}
    {-called recursively in recursive mode}
  VAR
    dirs : Darray;
    dName : DriveName;
    pName, UsePath : PathName;
    fName : FileString;
    filNum : Integer;
    driveNum : Byte;

    PROCEDURE ParseDTA(VAR name, ext : FileString);
      {-return a name and extension from a DTA}
    VAR
      i : Byte;
      tempName : FileString;
    BEGIN
      i := 1;
      WHILE dta.FullName[i] <> #0 DO i := Succ(i);
      i := Pred(i);
      Move(dta.FullName, tempName[1], i);
      tempName[0] := Chr(i);
      i := Pos('.', tempName);
      IF i <= 1 THEN BEGIN
        name := tempName;
        ext := '';
      END ELSE BEGIN
        name := Copy(tempName, 1, Pred(i));
        ext := Copy(tempName, Succ(i), 3);
      END;
    END;                      {parsedta}

    FUNCTION GetFirst(attr : Integer; VAR StartPath : PathName;
                      VAR name, ext : FileString;
                      VAR rightdirattr : Boolean) : Boolean;
      {-return true and a name if first file is found}
    VAR
      foundone : Boolean;
    BEGIN
      reg.ah := $4E;
      reg.ds := Seg(StartPath);
      reg.dx := Ofs(StartPath[1]);
      reg.cx := attr;
      MsDos(reg);
      foundone := ((reg.flags AND 1) = 0);
      rightdirattr := (dta.attr AND 16) = (attr AND 16);
      IF foundone THEN
        {scan the DTA for the file name and extension}
        ParseDTA(name, ext);
      GetFirst := foundone;
    END;                      {getfirst}

    FUNCTION GetNext(attr : Integer; VAR name, ext : FileString;
                     VAR rightdirattr : Boolean) : Boolean;
      {-return true and a name if another file is found}
    VAR
      foundone : Boolean;
    BEGIN
      reg.ah := $4F;
      reg.ds := Seg(dta);
      reg.dx := Ofs(dta);
      MsDos(reg);
      foundone := ((reg.flags AND 1) = 0);
      rightdirattr := (dta.attr AND 16) = (attr AND 16);
      IF foundone THEN
        {scan the DTA for the file name and extension}
        ParseDTA(name, ext);
      GetNext := foundone;
    END;                      {getnext}

    PROCEDURE GetFiles(attr : Integer;
                       VAR files : Farray;
                       VAR StartPath : PathName);
      {-return the files in the files array}
    VAR
      tempName, tempExt : FileString;
      rightdir : Boolean;

    BEGIN
      WITH files DO BEGIN
        StartPath[Succ(Length(StartPath))] := #0;
        num := 0;
        IF GetFirst(attr, StartPath, tempName, tempExt, rightdir) THEN
          REPEAT
            IF rightdir AND (tempName[1] <> '.') THEN BEGIN
              num := Succ(num);
              WITH arr[num] DO BEGIN
                name := tempName;
                ext := tempExt;
              END;
            END;
          UNTIL (num = MaxFiles) OR NOT(GetNext(attr, tempName, tempExt, rightdir));
      END;
    END;                      {getfiles}

    PROCEDURE GetDirs(attr : Integer;
                      VAR dirs : Darray;
                      VAR StartPath : PathName);
      {-return the directory names in the dirs array}
    VAR
      tempName, tempExt : FileString;
      rightdir : Boolean;
    BEGIN
      WITH dirs DO BEGIN
        StartPath[Succ(Length(StartPath))] := #0;
        num := 0;
        IF GetFirst(attr, StartPath, tempName, tempExt, rightdir) THEN
          REPEAT
            IF rightdir AND (tempName[1] <> '.') THEN BEGIN
              num := Succ(num);
              arr[num] := tempName;
              IF tempExt <> '' THEN arr[num] := arr[num]+'.'+tempExt;
            END;
          UNTIL (num = MaxDirs) OR NOT(GetNext(attr, tempName, tempExt, rightdir));
      END;
    END;                      {getdirs}

    PROCEDURE Analyze(driveNum : Byte; VAR fName : CompositeFilename);
      {-scan the file fname looking for the matchpattern}
    VAR
      FCB : UnopenedFCBrec;
      FCBreturn : UnopenedFCBrec ABSOLUTE dta;
      Breaks, LastCluster, Cluster : Integer;
      EndOfFile : Boolean;
      FATentry : Integer;
      FileClusters : Integer;
      Efficiency : Real;

      PROCEDURE InitFCB(VAR FCB : UnopenedFCBrec;
                        driveNum : Byte;
                        name : FileName;
                        ext : ExtName);
        {-set up fcb for directory call}
      BEGIN
        FillChar(FCB, SizeOf(FCB), 32);
        WITH FCB DO BEGIN
          flag := $FF;
          SearchAttr := 7;
          drive := driveNum;
          Move(name[1], fName, Length(name));
          IF Length(ext) > 0 THEN
            Move(ext[1], fExt, Length(ext));
        END;
      END;                    {initfcb}

      FUNCTION GetFATentry(Cluster : Integer) : Integer;
        {-return the FAT entry for the specified cluster}
      VAR
        t : Integer;
        oddeven : Integer;
      BEGIN
        IF bigFAT THEN
          Move(FAT^[Cluster SHL 1], t, 2)
        ELSE BEGIN
          oddeven := 3*Cluster;
          Move(FAT^[oddeven SHR 1], t, 2);
          IF Odd(oddeven) THEN
            t := t SHR 4
          ELSE
            t := t AND $FFF;
        END;
        GetFATentry := t;
      END;                    {getfatentry}

      FUNCTION LastFATentry(FATentry : Integer) : Boolean;
        {-return true if the last FAT entry for the file}
      BEGIN
        IF bigFAT THEN
          LastFATentry := ((FATentry SHR 4) = $FFF) AND ((FATentry AND $F) >= 8)
        ELSE
          LastFATentry := (FATentry >= $FF8);
      END;                    {lastfatentry}

      FUNCTION FormattedName(dname:drivename;
                             pname:pathname;
                             name : FileName;
                             ext : ExtName) : pathname;
        {-return a formatted name right padded with blanks}
      VAR
        t : pathname;
      BEGIN
        t := name;
        IF ext <> '' THEN
          t := t+'.'+ext;
        t:=dname+pname+t;
        WHILE Length(t) < 40 DO t := t+' ';
        FormattedName := t;
      END;                    {formattedname}

    BEGIN

      IF BreakPressed THEN BreakHalt;

      WITH fName DO BEGIN

        {fill in the FCB}
        InitFCB(FCB, driveNum, name, ext);

        {get detailed directory info from DOS}
        reg.ah := $11;
        reg.ds := Seg(FCB);
        reg.dx := Ofs(FCB);
        MsDos(reg);
        IF reg.al = $FF THEN BEGIN
          WriteLn(err, 'ERROR: file not found... ', name, '.', ext);
          DoHalt(1);
        END;

        {found the file, now trace its FAT}
        Cluster := FCBreturn.fCluster;
        LastCluster := Pred(Cluster);
        FileClusters := 1;
        Breaks := 0;
        REPEAT
          IF Cluster <> Succ(LastCluster) THEN
            Breaks := Succ(Breaks);
          FATentry := GetFATentry(Cluster);
          EndOfFile := LastFATentry(FATentry);
          IF NOT EndOfFile THEN BEGIN
            FileClusters := Succ(FileClusters);
            LastCluster := Cluster;
            Cluster := FATentry;
          END;
        UNTIL EndOfFile;

        {update counters}
        fCount := Succ(fCount);
        IF Breaks > 0 THEN BEGIN
          fBroken := Succ(fBroken);
          TotalBreaks := TotalBreaks+Breaks;
        END;
        ClustersUsed := ClustersUsed+FileClusters;
        IF FileClusters = 1 THEN
          Efficiency := 100.0
        ELSE
          Efficiency := 100.0*(1.0-Int(Breaks)/Int(FileClusters-1));

        IF verbose OR (Efficiency <> 100.0) THEN BEGIN
          WroteFile := True;
          {.F-}
          WriteLn(FormattedName(dname,pname,name,ext),' ',
                  FCBreturn.fCluster:5,' ',
                  FileClusters:5,' ',
                  Breaks:5,' ',
                  1.0*secsize*FileClusters*secsPerAllo:7:0, ' ',
                  efficiency:5:1
                  );
          {.F+}
        END;
      END;
    END;                      {analyze}

  BEGIN
    {get a list of all normal, readonly, hidden matching files in startpath}
    ParsePath(StartPath, dName, pName, fName);
    UsePath := dName+pName+fName;
    GetFiles(7, files, UsePath);

    {move to the current directory to allow FCBs}
    ChDir(Path('', pName));
    driveNum := ReturnDriveNum(dName);

    {check each file}
    FOR filNum := 1 TO files.num DO Analyze(driveNum, files.arr[filNum]);

    {look at subdirectories}
    IF recursive THEN BEGIN
      {get all subdirectories}
      UsePath := dName+pName+'*.*';
      GetDirs(19, dirs, UsePath);
      {look in the subdirectories}
      FOR filNum := 1 TO dirs.num DO BEGIN
        {build a pathname to the subdirectory}
        UsePath := dName+pName+dirs.arr[filNum]+'\'+fName;
        {call recursively}
        ScanFiles(UsePath);
      END;
    END;
  END;                        {scanfiles}

  PROCEDURE InitializeGlobals;
    {-set up all global data structures}
  BEGIN
    {get default directory and disk}
    GetDir(0, StartPath);
    SavePath := StartPath;
    consoleout:=iostat(1);
    errorptr := Ofs(error);
    Assign(err, 'ERR:');
    Rewrite(err);
    SetBreak;
    SetDTA(dta);
    {set default flags and counters}
    recursive := False;
    verbose := false;
    fCount := 0;
    TotalBreaks := 0;
    ClustersUsed := 0;
    fBroken := 0;
    WroteFile := False;
  END;                        {initializeglobals}

  PROCEDURE GetDriveInfo;
    {-determine number of clusters, fat entry size, etc. for the specified drive}
  VAR
    dName : DriveName;
    pName : PathName;
    fName : FileString;
    driveNum : Byte;
    driveid : Byte;
    error : Integer;
    fatofs, sec : Integer;

    PROCEDURE getFAT(DOSnum : Byte; VAR driveid : Byte;
                     VAR secSize, alloUnits, secsPerAllo : Integer);
      {-read the FAT ID info for the specified drive}
    BEGIN
      reg.ah := $1C;
      reg.dl := DOSnum;
      MsDos(reg);
      secSize := reg.cx;
      alloUnits := reg.dx;
      secsPerAllo := reg.al;
      driveid := Mem[reg.ds:reg.bx];
    END;                      {getfat}

    FUNCTION GetFreeSpace(driveNum : Byte) : Integer;
      {-return the number of free clusters on the drive}
    BEGIN
      reg.ah := $36;
      reg.dl := Succ(driveNum);
      MsDos(reg);
      GetFreeSpace := reg.bx;
    END;                      {GetFreeSpace}

    PROCEDURE DOSreadSectors(drive : Byte;
                             LSN : Integer;
                             sects : Integer;
                             VAR buffer;
                             VAR error : Integer);
      {-execute int 25 to read disk through DOS at low level}
    BEGIN
      INLINE(
        $1E/                  {PUSH    DS}
        $8A/$46/$10/          {MOV    AL,[BP+10]}
        $8B/$56/$0E/          {MOV    DX,[BP+0E]}
        $8B/$4E/$0C/          {MOV    CX,[BP+0C]}
        $C5/$5E/$08/          {LDS    BX,[BP+08]}
        $CD/$25/              {INT    25}
        $72/$02/              {JB    0113}
        $31/$C0/              {XOR    AX,AX}
        $9D/                  {POPF    }
        $1F/                  {POP    DS}
        $5D/                  {POP    BP}
        $C4/$7E/$04/          {LES    DI,[BP+04]}
        $26/                  {ES:    }
        $89/$05               {MOV    [DI],AX}
        );
    END;                      {dosreadsectors}

    FUNCTION CurrentDrive : Byte;
      {-return the current drive number, 0=A, 1=B}
    BEGIN
      reg.ah := $19;
      MsDos(reg);
      CurrentDrive := reg.al;
    END;                      {currentdrive}

  BEGIN
    {break up the starting path}
    ParsePath(StartPath, dName, pName, fName);

    {change to the drive we're analyzing}
    IF dName <> '' THEN BEGIN
      ChDir(dName);
      driveNum := ReturnDriveNum(dName)-1; {0=A,1=B}
    END ELSE
      driveNum := CurrentDrive;

    {get FAT information}
    getFAT(0, driveid, secSize, alloUnits, secsPerAllo);

    {test whether 8 bit or 16 bit fat}
    bigFAT := (alloUnits < 0) OR (alloUnits > 4086);

    {allocate memory where we will keep the FAT}
    IF bigFAT THEN
      FATbytes := alloUnits SHL 1
    ELSE
      FATbytes := (3*alloUnits) SHR 1;
    IF FATbytes <= 0 THEN BEGIN
      WriteLn(err, 'Error in FAT size calculation');
      DoHalt(1);
    END;
    GetMem(FAT, FATbytes);

    FATsectors := FATbytes DIV secSize;
    IF (FATbytes AND Pred(secSize)) <> 0 THEN FATsectors := Succ(FATsectors);
    {read in the FAT}
    fatofs := 0;
    sec := 1;
    WHILE sec <= FATsectors DO BEGIN
      DOSreadSectors(driveNum, sec, 1, FAT^[fatofs], error);
      IF error <> 0 THEN BEGIN
        WriteLn(err, 'error reading FAT');
        DoHalt(1);
      END;
      sec := Succ(sec);
      fatofs := fatofs+512;
    END;

    {get number of available clusters}
    AvailableClusters := GetFreeSpace(driveNum);

  END;                        {getdriveinfo}

  PROCEDURE WriteResults;
  VAR
    Efficiency : Real;
  BEGIN
    IF ClustersUsed = 1 THEN
      Efficiency := 100.0
    ELSE
      Efficiency := 100.0*(1.0-TotalBreaks/(ClustersUsed-1.0));
    WriteLn(err);
    WriteLn(err, 'total files analyzed               : ', fCount);
    WriteLn(err, 'total clusters used in these files : ', ClustersUsed);
    WriteLn(err, 'total files with cluster breaks    : ', fBroken);
    WriteLn(err, 'total cluster breaks               : ', TotalBreaks);
    WriteLn(err, 'total free clusters on disk        : ', AvailableClusters);
    WriteLn(err, 'total clusters on disk             : ', alloUnits);
    WriteLn(err, 'percent of disk free               : ', (100.0*AvailableClusters/alloUnits):0:1, '%');
    WriteLn(err, 'total bytes on disk                : ', (1.0*secSize*secsPerAllo*alloUnits):0:0);
    WriteLn(err, 'percent of clusters contiguous     : ', Efficiency:0:1, '%');
    IF tStop-tStart <= 0 THEN Exit;
    WriteLn(err, 'file rate                          : ', (fCount/(tStop-tStart)):0:1, ' files/sec');
  END;                        {writeresults}

BEGIN
  InitializeGlobals;
  SetOptions;
  WriteLn(err, 'Disk Performance Analyzer - by TurboPower Software - version ',version);
  GetDriveInfo;
  if consoleout then begin
    writeln(err);
    WriteLn(err,'Filename                                Start Clusters Breaks Bytes Effic');
  end;
  Time(tStart);
  ScanFiles(StartPath);
  Time(tStop);
  IF consoleout and not(WroteFile) THEN
    WriteLn(err,'--------------------- none --------------------------');
  WriteResults;
  ChDir(SavePath);
END.